home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibt3sp3.arc / PROCESSS.PAS < prev    next >
Pascal/Delphi Source File  |  1985-10-06  |  54KB  |  1,367 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Process_Script --- Convert PibTerm script file to in-core code.    *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. OVERLAY PROCEDURE Process_Script;
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Process_Script                                       *)
  10. (*                                                                      *)
  11. (*     Purpose:    Convert PibTerm script file to in-core instructions. *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*         Process_Script;                                              *)
  16. (*                                                                      *)
  17. (*      Remarks:                                                        *)
  18. (*                                                                      *)
  19. (*         The entire script file is read and converted to an in-core   *)
  20. (*         representation which can be executed.                        *)
  21. (*                                                                      *)
  22. (*         At this time, user-defined labels are not allowed.  There    *)
  23. (*         are some variable related to them here, however.  The next   *)
  24. (*         time around (PibTerm v4.0) they will be used to allow for    *)
  25. (*         case statements and procedures in scripts.                   *)
  26. (*                                                                      *)
  27. (*----------------------------------------------------------------------*)
  28.  
  29. CONST                              (* Maximum # of labels allowed *)
  30.    Max_Script_Labels = 20;
  31.                                    (* Maximum stack depth         *)
  32.    Max_Script_Stack  = 10;
  33.  
  34. TYPE                               
  35.                                    (* Points to a label reference *)
  36.  
  37.    Script_Label_Ptr = ^Script_Label_Reference;
  38.  
  39.                                    (* Records one label reference *)
  40.    Script_Label_Reference = RECORD
  41.                                                (* Offset in script buffer *)
  42.                                Buffer_Pos : INTEGER;
  43.                                                (* Next reference *)
  44.                                Next_Ref   : Script_Label_Ptr;
  45.  
  46.                             END;
  47.  
  48.    Script_Label_Type = RECORD
  49.                                           (* Label name *)
  50.                           Name       : STRING[12];
  51.                                           (* Label definition position *)
  52.                           Buffer_Pos : INTEGER;
  53.                                           (* Pointer to first reference *)
  54.                           First_Ref  : Script_Label_Ptr;
  55.  
  56.                        END;
  57.  
  58. VAR
  59.                                    (* Number of labels currently defined *)
  60.  
  61.    Script_Label_Count     : INTEGER;
  62.  
  63.                                    (* Script label definition vector *)
  64.  
  65.    Script_Labels          : ARRAY[1..Max_Script_Labels] OF Script_Label_Type;
  66.  
  67.                                    (* Current stack levels, conditional     *)
  68.                                    (* script commands.                      *)
  69.  
  70.    Script_Repeat_Level    : INTEGER;
  71.    Script_If_Level        : INTEGER;
  72.    Script_While_Level     : INTEGER;
  73.  
  74.                                    (* Stacks for conditional commands       *)
  75.  
  76.    Script_Repeat_Stack    : ARRAY[1..Max_Script_Stack] OF INTEGER;
  77.    Script_If_Stack        : ARRAY[1..Max_Script_Stack] OF INTEGER;
  78.    Script_While_Stack     : ARRAY[1..Max_Script_Stack] OF INTEGER;
  79.  
  80.    L                      : INTEGER;
  81.    I                      : INTEGER;
  82.    K                      : INTEGER;
  83.    IS                     : INTEGER;
  84.    Local_Save             : Saved_Screen_Ptr;
  85.    Ch                     : CHAR;
  86.    Text_Line              : AnyStr;
  87.    Byte_File              : FILE OF BYTE;
  88.    OK_Script_Command      : BOOLEAN;
  89.    Script_Command_Token   : AnyStr;
  90.    Script_Line            : AnyStr;
  91.    Saved_Script_Line      : AnyStr;
  92.    Current_Script_Command : PibTerm_Command_Type;
  93.  
  94.    Script_Debug_File      : TEXT;
  95.    Script_Debug_Mode      : BOOLEAN;
  96.  
  97. (*----------------------------------------------------------------------*)
  98. (*             Get_Quoted_String --- pick up string in quotes           *)
  99. (*----------------------------------------------------------------------*)
  100.  
  101. PROCEDURE Get_Quoted_String(     S    : AnyStr;
  102.                              VAR IS   : INTEGER;
  103.                              VAR QS   : AnyStr;
  104.                              VAR Quote: CHAR );
  105.  
  106. (*----------------------------------------------------------------------*)
  107. (*                                                                      *)
  108. (*     Procedure:  Get_Quoted_String                                    *)
  109. (*                                                                      *)
  110. (*     Purpose:    Extracts quoted string from a string.                *)
  111. (*                                                                      *)
  112. (*     Calling Sequence:                                                *)
  113. (*                                                                      *)
  114. (*        Get_Quoted_String(      S    : AnyStr;                        *)
  115. (*                           VAR IS    : INTEGER;                       *)
  116. (*                           VAR QS    : AnyStr;                        *)
  117. (*                           VAR Quote : CHAR );                        *)
  118. (*                                                                      *)
  119. (*            S     --- string containing quoted string                 *)
  120. (*            IS    --- current position in S                           *)
  121. (*            QS    --- resultant extracted string (no quotes)          *)
  122. (*            Quote --- quote character (blank if quotes not found)     *)
  123. (*                                                                      *)
  124. (*      Remarks:                                                        *)
  125. (*                                                                      *)
  126. (*         A quote within a string can be entered by putting two quotes *)
  127. (*         together, e.g., 'ab''c' -->  ab'c.                           *)
  128. (*                                                                      *)
  129. (*----------------------------------------------------------------------*)
  130.  
  131. VAR
  132.    LS         : INTEGER;
  133.    End_String : BOOLEAN;
  134.  
  135. BEGIN (* Get_Quoted_String *)
  136.                                    (* Null string is default *)
  137.    QS    := '';
  138.    Quote := ' ';
  139.                                    (* Skip leading blanks *)
  140.    LS    := LENGTH( S );
  141.  
  142.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  143.       IS := IS + 1;
  144.                                    (* See if we have a quote *)
  145.    IF ( IS <= LS ) THEN
  146.       BEGIN
  147.  
  148.          IF S[IS] IN ['''','"'] THEN
  149.             BEGIN
  150.                                    (* Pickup quoted string is so *)
  151.                Quote      := S[IS];
  152.                End_String := FALSE;
  153.  
  154.                REPEAT
  155.  
  156.                   IS := IS + 1;
  157.                                    (* Note:  two quotes in a row used   *)
  158.                                    (*        to indicate single quote   *)
  159.                                    (*        to be inserted into string *)
  160.  
  161.                   IF IS <= LS THEN
  162.                      IF S[IS] <> Quote THEN
  163.                         QS := QS + S[IS]
  164.                      ELSE
  165.                         BEGIN
  166.                            IF ( IS + 1 ) <= LS THEN
  167.                               IF S[IS+1] = Quote THEN
  168.                                  BEGIN
  169.                                     QS := QS + Quote;
  170.                                     IS := IS + 1;
  171.                                  END
  172.                               ELSE
  173.                                  End_String := TRUE
  174.                            ELSE
  175.                               End_String := TRUE;
  176.                         END
  177.                   ELSE
  178.                      End_String := TRUE;
  179.  
  180.                UNTIL End_String;
  181.  
  182.             END;
  183.  
  184.       END;
  185.  
  186. END   (* Get_Quoted_String *);
  187.  
  188. (*----------------------------------------------------------------------*)
  189. (*                     Get_String --- Pick up string                    *)
  190. (*----------------------------------------------------------------------*)
  191.  
  192. PROCEDURE Get_String(     S    : AnyStr;
  193.                       VAR IS   : INTEGER;
  194.                       VAR QS   : AnyStr;
  195.                       VAR Delim: CHAR );
  196.  
  197. (*----------------------------------------------------------------------*)
  198. (*                                                                      *)
  199. (*     Procedure:  Get_String                                           *)
  200. (*                                                                      *)
  201. (*     Purpose:    Extracts string up to a delimeter.                   *)
  202. (*                                                                      *)
  203. (*     Calling Sequence:                                                *)
  204. (*                                                                      *)
  205. (*        Get_String(      S     : AnyStr;                              *)
  206. (*                     VAR IS    : INTEGER;                             *)
  207. (*                     VAR QS    : AnyStr;                              *)
  208. (*                     VAR Delim : CHAR );                              *)
  209. (*                                                                      *)
  210. (*            S     --- string containing string to extract             *)
  211. (*            IS    --- current position in S                           *)
  212. (*            QS    --- resultant extracted string                      *)
  213. (*            Delim --- delimeter character                             *)
  214. (*                                                                      *)
  215. (*----------------------------------------------------------------------*)
  216.  
  217. VAR
  218.    LS         : INTEGER;
  219.    End_String : BOOLEAN;
  220.    Ch         : CHAR;
  221.  
  222. BEGIN (* Get_String *)
  223.                                    (* Null string is default *)
  224.    QS    := '';
  225.    Delim := ' ';
  226.                                    (* Skip leading blanks *)
  227.    LS    := LENGTH( S );
  228.  
  229.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  230.       IS := IS + 1;
  231.                                    (* Copy up to non-letter, non-digit *)
  232.    End_String := FALSE;
  233.  
  234.    IF ( IS <= LS ) THEN
  235.       REPEAT
  236.  
  237.          Ch := S[IS];
  238.  
  239.          IF ( Ch IN ['A'..'Z','a'..'z','0'..'9'] ) THEN
  240.             BEGIN
  241.                QS := QS + Ch;
  242.                IS := IS + 1;
  243.             END
  244.          ELSE
  245.             BEGIN
  246.                End_String := TRUE;
  247.                Delim      := Ch;
  248.             END;
  249.  
  250.       UNTIL End_String;
  251.  
  252. END   (* Get_String *);
  253.  
  254. (*----------------------------------------------------------------------*)
  255. (*                  Get_Integer --- pick up integer                     *)
  256. (*----------------------------------------------------------------------*)
  257.  
  258. PROCEDURE Get_Integer(     S     : AnyStr;
  259.                        VAR IS    : INTEGER;
  260.                        VAR Qnum  : BOOLEAN;
  261.                        VAR IntVal: INTEGER );
  262.  
  263. (*----------------------------------------------------------------------*)
  264. (*                                                                      *)
  265. (*     Procedure:  Get_Integer                                          *)
  266. (*                                                                      *)
  267. (*     Purpose:    Extracts integer from a string.                      *)
  268. (*                                                                      *)
  269. (*     Calling Sequence:                                                *)
  270. (*                                                                      *)
  271. (*        Get_Integer(      S      : AnyStr;                            *)
  272. (*                      VAR IS     : INTEGER;                           *)
  273. (*                      VAR Qnum   : BOOLEAN;                           *)
  274. (*                      VAR IntVal : INTEGER   );                       *)
  275. (*                                                                      *)
  276. (*            S      --- string containing quoted string                *)
  277. (*            IS     --- current position in S                          *)
  278. (*            Qnum   --- TRUE if a number extracted                     *)
  279. (*            IntVal --- integer extracted or 0 if none                 *)
  280. (*                                                                      *)
  281. (*----------------------------------------------------------------------*)
  282.  
  283. VAR
  284.    LS         : INTEGER;
  285.    End_Of_Num : BOOLEAN;
  286.    Int_Sign   : INTEGER;
  287.  
  288. BEGIN (* Get_Integer *)
  289.                                    (* Skip leading blanks *)
  290.    LS     := LENGTH( S );
  291.  
  292.    WHILE ( IS <= LS ) AND ( S[IS] = ' ' ) DO
  293.       IS := IS + 1;
  294.                                    (* Default value is zero *)
  295.    IntVal     := 0;
  296.    Qnum       := FALSE;
  297.    End_Of_Num := FALSE;
  298.    Int_Sign   := 1;
  299.                                    (* Pick up minus sign    *)
  300.    IF ( IS <= LS ) THEN
  301.       IF ( S[IS] = '-' ) THEN
  302.          BEGIN
  303.             Int_Sign := -1;
  304.             IS       := IS + 1;
  305.          END;
  306.                                    (* Pick up digits if any *)
  307.    REPEAT
  308.  
  309.       IF ( IS <= LS ) THEN
  310.          IF S[IS] IN ['0'..'9'] THEN
  311.             BEGIN
  312.                IntVal := IntVal * 10 + ORD( S[IS] ) - ORD('0');
  313.                Qnum   := TRUE;
  314.             END
  315.          ELSE
  316.             End_Of_Num := TRUE
  317.       ELSE
  318.          End_Of_Num := TRUE;
  319.  
  320.       IF ( NOT End_Of_Num ) THEN
  321.          IS := IS + 1;
  322.  
  323.    UNTIL ( End_Of_Num );
  324.  
  325.    IntVal := IntVal * Int_Sign;
  326.  
  327. END   (* Get_Integer *);
  328.  
  329. (*----------------------------------------------------------------------*)
  330. (*    Copy_String_To_Buffer --- Copy string from script line to buffer  *)
  331. (*----------------------------------------------------------------------*)
  332.  
  333. PROCEDURE Copy_String_To_Buffer;
  334.  
  335. (*----------------------------------------------------------------------*)
  336. (*                                                                      *)
  337. (*     Procedure:  Copy_String_To_Buffer                                *)
  338. (*                                                                      *)
  339. (*     Purpose:    Copies quoted string from script line to buffer      *)
  340. (*                                                                      *)
  341. (*     Calling Sequence:                                                *)
  342. (*                                                                      *)
  343. (*        Copy_String_To_Buffer;                                        *)
  344. (*                                                                      *)
  345. (*----------------------------------------------------------------------*)
  346.  
  347. VAR
  348.    L     : INTEGER;
  349.    Quote : CHAR;
  350.    I     : INTEGER;
  351.  
  352. BEGIN (* Copy_String_To_Buffer *)
  353.  
  354.    Get_Quoted_String( Script_Line, IS, Text_Line, Quote );
  355.  
  356.    L := LENGTH( Text_Line );
  357.  
  358.    IF ( NOT ( Quote IN ['''','"'] ) ) THEN
  359.       L := 0;
  360.  
  361.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  362.    Script_Buffer^[Script_Buffer_Pos] := L;
  363.  
  364.    IF Script_Debug_Mode THEN
  365.        WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', L:4 );
  366.  
  367.    FOR I := 1 TO L DO
  368.       BEGIN
  369.          Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  370.          Script_Buffer^[Script_Buffer_Pos] := ORD( Text_Line[I] );
  371.       END;
  372.  
  373.    IF Script_Debug_Mode THEN
  374.        BEGIN
  375.           WRITE  ( Script_Debug_File , ' ', Text_Line );
  376.           WRITELN( Script_Debug_File );
  377.        END;
  378.  
  379. END   (* Copy_String_To_Buffer *);
  380.  
  381. (*----------------------------------------------------------------------*)
  382. (*     Copy_Integer_To_Buffer --- Copy integer to script line buffer    *)
  383. (*----------------------------------------------------------------------*)
  384.  
  385. PROCEDURE Copy_Integer_To_Buffer( IntVal : INTEGER );
  386.  
  387. (*----------------------------------------------------------------------*)
  388. (*                                                                      *)
  389. (*     Procedure:  Copy_Integer_To_Buffer                               *)
  390. (*                                                                      *)
  391. (*     Purpose:    Copies integer to script line buffer                 *)
  392. (*                                                                      *)
  393. (*     Calling Sequence:                                                *)
  394. (*                                                                      *)
  395. (*        Copy_Integer_To_Buffer( IntVal : INTEGER );                   *)
  396. (*                                                                      *)
  397. (*           IntVal --- Value to place in script buffer                 *)
  398. (*                                                                      *)
  399. (*----------------------------------------------------------------------*)
  400.  
  401. VAR
  402.    Int_Bytes : ARRAY[1..2] OF BYTE ABSOLUTE IntVal;
  403.  
  404. BEGIN (* Copy_Integer_To_Buffer *)
  405.  
  406.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  407.    Script_Buffer^[Script_Buffer_Pos] := Int_Bytes[1];
  408.  
  409.    IF Script_Debug_Mode THEN
  410.        WRITELN( Script_Debug_File , Script_Buffer_Pos:4 , ' ',
  411.                 Int_Bytes[1]:4, Int_Bytes[2]:4, ' ', IntVal:8,
  412.                 ' (Integer)');
  413.  
  414.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  415.    Script_Buffer^[Script_Buffer_Pos] := Int_Bytes[2];
  416.  
  417. END   (* Copy_Integer_To_Buffer *);
  418.  
  419. (*----------------------------------------------------------------------*)
  420. (*        Copy_Byte_To_Buffer --- Copy byte to script line buffer       *)
  421. (*----------------------------------------------------------------------*)
  422.  
  423. PROCEDURE Copy_Byte_To_Buffer( ByteVal : INTEGER );
  424.  
  425. (*----------------------------------------------------------------------*)
  426. (*                                                                      *)
  427. (*     Procedure:  Copy_Byte_To_Buffer                                  *)
  428. (*                                                                      *)
  429. (*     Purpose:    Copies byte to script line buffer                    *)
  430. (*                                                                      *)
  431. (*     Calling Sequence:                                                *)
  432. (*                                                                      *)
  433. (*        Copy_Byte_To_Buffer( IntVal : INTEGER );                      *)
  434. (*                                                                      *)
  435. (*           ByteVal --- Value to place in script buffer                *)
  436. (*                                                                      *)
  437. (*----------------------------------------------------------------------*)
  438.  
  439. BEGIN (* Copy_Byte_To_Buffer *)
  440.  
  441.    Script_Buffer_Pos                 := Script_Buffer_Pos + 1;
  442.    Script_Buffer^[Script_Buffer_Pos] := ByteVal;
  443.  
  444.    IF Script_Debug_Mode THEN
  445.        BEGIN
  446.           WRITE( Script_Debug_File , Script_Buffer_Pos:4 , ' ', ByteVal,
  447.                  ' (Byte)' );
  448.           IF ( ByteVal > 32 ) AND ( ByteVal < 127 ) THEN
  449.              WRITE( Script_Debug_File , ' (',CHR( ByteVal ),')' );
  450.           WRITELN( Script_Debug_File );
  451.        END;
  452.  
  453. END   (* Copy_Integer_To_Buffer *);
  454.  
  455. (*----------------------------------------------------------------------*)
  456. (*    Copy_Protocol_To_Buffer --- Copy transfer protocol to buffer      *)
  457. (*----------------------------------------------------------------------*)
  458.  
  459. PROCEDURE Copy_Protocol_To_Buffer;
  460.  
  461. (*----------------------------------------------------------------------*)
  462. (*                                                                      *)
  463. (*     Procedure:  Copy_Protocol_To_Buffer                              *)
  464. (*                                                                      *)
  465. (*     Purpose:    Copies file transfer protocol to buffer              *)
  466. (*                                                                      *)
  467. (*     Calling Sequence:                                                *)
  468. (*                                                                      *)
  469. (*        Copy_Protocol_To_Buffer;                                      *)
  470. (*                                                                      *)
  471. (*----------------------------------------------------------------------*)
  472.  
  473. VAR
  474.    LS                : INTEGER;
  475.    Transfer_Protocol : Transfer_Type;
  476.    Trans_Mode        : STRING[10];
  477.    End_Of_Protocol   : BOOLEAN;
  478.    Delim             : CHAR;
  479.  
  480. BEGIN (* Copy_Protocol_To_Buffer *)
  481.  
  482.                                    (* Get transfer mode *)
  483.  
  484.    Get_String( Script_Line, IS, Trans_Mode, Delim );
  485.  
  486.    IF LENGTH( Trans_Mode ) > 0 THEN
  487.       Trans_Mode := UpperCase( Trans_Mode )
  488.    ELSE
  489.       Trans_Mode := 'Z';
  490.  
  491.    Transfer_Protocol := Default_Transfer_Type;
  492.  
  493.    IF Trans_Mode = 'A'  THEN
  494.       Transfer_Protocol := Ascii
  495.    ELSE IF Trans_Mode = 'X'  THEN
  496.       Transfer_Protocol := Xmodem_Chk
  497.    ELSE IF Trans_Mode = 'XC' THEN
  498.       Transfer_Protocol := Xmodem_CRC
  499.    ELSE IF Trans_Mode = 'Y'  THEN
  500.       Transfer_Protocol := Ymodem
  501.    ELSE IF Trans_Mode = 'YB' THEN
  502.       Transfer_Protocol := Ymodem_Batch
  503.    ELSE IF Trans_Mode = 'T'  THEN
  504.       Transfer_Protocol := Telink
  505.    ELSE IF Trans_Mode = 'TC' THEN
  506.       Transfer_Protocol := Telink
  507.    ELSE IF Trans_Mode = 'M'  THEN
  508.        Transfer_Protocol := Modem7_Chk
  509.    ELSE IF Trans_Mode = 'MC'  THEN
  510.        Transfer_Protocol := Modem7_CRC
  511.    ELSE IF Trans_Mode = 'M7' THEN
  512.       Transfer_Protocol := Modem7_CRC
  513.    ELSE IF Trans_Mode = 'K' THEN
  514.          BEGIN
  515.             Transfer_Protocol    := Kermit;
  516.             Kermit_File_Type_Var := Kermit_Ascii;
  517.          END
  518.       ELSE IF Trans_Mode = 'KB' THEN
  519.          BEGIN
  520.             Transfer_Protocol    := Kermit;
  521.             Kermit_File_Type_Var := Kermit_Binary;
  522.          END;
  523.  
  524.    Copy_Integer_To_Buffer( ORD( Transfer_Protocol ) + 1 );
  525.  
  526. END   (* Copy_Protocol_To_Buffer *);
  527.  
  528. (*----------------------------------------------------------------------*)
  529. (*    Extract_Script_Command --- Extract command type from script line  *)
  530. (*----------------------------------------------------------------------*)
  531.  
  532. PROCEDURE Extract_Script_Command( VAR OK_Script_Command : BOOLEAN );
  533.  
  534. (*----------------------------------------------------------------------*)
  535. (*                                                                      *)
  536. (*     Procedure:  Extract_Script_Command                               *)
  537. (*                                                                      *)
  538. (*     Purpose:    Extracts command name from script line               *)
  539. (*                                                                      *)
  540. (*     Calling Sequence:                                                *)
  541. (*                                                                      *)
  542. (*        Extract_Script_Command( VAR OK_Script_Command : BOOLEAN );    *)
  543. (*                                                                      *)
  544. (*           OK_Script_Command --- set TRUE if legitimate command       *)
  545. (*                                                                      *)
  546. (*----------------------------------------------------------------------*)
  547.  
  548. VAR
  549.    Found : BOOLEAN;
  550.    L     : INTEGER;
  551.  
  552. BEGIN (* Extract_Script_Command *)
  553.  
  554.                                    (* Remove initial, trailing blanks *)
  555.  
  556.    Script_Line := LTRIM( TRIM( Script_Line ) );
  557.    L           := LENGTH( Script_Line );
  558.  
  559.                                    (* If nothing left, ignore this line *)
  560.  
  561.    IF ( L < 1 ) THEN
  562.       Current_Script_Command := Null_Command
  563.    ELSE
  564.       BEGIN
  565.                                    (* Append blank to script line *)
  566.  
  567.          Script_Line := Script_Line + ' ';
  568.  
  569.                                    (* Pick up command name        *)
  570.  
  571.          Script_Command_Token := '';
  572.          I                    := 1;
  573.  
  574.          WHILE( Script_Line[I] <> ' ' ) DO
  575.             BEGIN
  576.                Script_Command_Token := Script_Command_Token +
  577.                                        UpCase( Script_Line[I] );
  578.                I                    := I + 1;
  579.             END;
  580.                                     (* Abbreviate command to 8 chars *)
  581.  
  582.          IF ( LENGTH( Script_Command_Token ) > 8 ) THEN
  583.             Script_Command_Token := COPY( Script_Command_Token, 1, 8 );
  584.  
  585.                                     (* Strip command text from front *)
  586.                                     (* of script text line           *)
  587.          I := I + 1;
  588.  
  589.          IF ( L - I + 1 ) > 0 THEN
  590.             Script_Line := COPY( Script_Line, I, L - I + 1 )
  591.          ELSE
  592.             Script_Line := '';
  593.  
  594.                                    (* Look up command in valid command list *)
  595.          I     := 0;
  596.          Found := FALSE;
  597.  
  598.          REPEAT
  599.             I     := I + 1;
  600.             Found := ( Script_Command_Token = Script_File_Command_Names[I] );
  601.          UNTIL  ( Found OR ( I >= Max_Script_File_Commands ) );
  602.  
  603.          IF ( NOT Found ) THEN
  604.             Current_Script_Command := Bad_Command
  605.          ELSE
  606.             Current_Script_Command := Script_File_Commands[I];
  607.  
  608.       END;
  609.  
  610.    OK_Script_Command := Current_Script_Command <> Bad_Command;
  611.  
  612. END   (* Extract_Script_Command *);
  613.  
  614. (*----------------------------------------------------------------------*)
  615. (*      Emit_Wait_String_Command --- Emit wait for string command       *)
  616. (*----------------------------------------------------------------------*)
  617.  
  618. PROCEDURE Emit_Wait_String_Command( VAR OK_Script_Command: BOOLEAN );
  619.  
  620. (*----------------------------------------------------------------------*)
  621. (*                                                                      *)
  622. (*     Procedure:  Emit_Wait_String_Command                             *)
  623. (*                                                                      *)
  624. (*     Purpose:    Emit command to wait for specified string            *)
  625. (*                                                                      *)
  626. (*     Calling Sequence:                                                *)
  627. (*                                                                      *)
  628. (*        Emit_Wait_String_Command( VAR OK_Script_Command : BOOLEAN );  *)
  629. (*                                                                      *)
  630. (*----------------------------------------------------------------------*)
  631.  
  632. VAR
  633.    Qnum   : BOOLEAN;
  634.    IntVal : INTEGER;
  635.  
  636. BEGIN (* Emit_Wait_String_Command *)
  637.  
  638.                                    (* String to wait for *)
  639.    Copy_String_To_Buffer;
  640.                                    (* Null reply string  *)
  641.  
  642.    Copy_Byte_To_Buffer( 0 );
  643.                                    (* Number of seconds to wait *)
  644.    IS := IS + 1;
  645.  
  646.    Get_Integer( Script_Line, IS, Qnum, IntVal );
  647.  
  648.    IF ( NOT Qnum ) THEN
  649.       IntVal := 30;
  650.  
  651.    Copy_Integer_To_Buffer( IntVal );
  652.  
  653.                                    (* Failure label *)
  654.  
  655.    Copy_Integer_To_Buffer( Script_Buffer_Pos + 3 );
  656.  
  657.    OK_Script_Command := TRUE;
  658.  
  659. END   (* Emit_Wait_String_Command *);
  660.  
  661. (*----------------------------------------------------------------------*)
  662. (*           Emit_If_Command --- Emit IF conditional command            *)
  663. (*----------------------------------------------------------------------*)
  664.  
  665. PROCEDURE Emit_If_Command(     False_Label       : INTEGER;
  666.                            VAR OK_Script_Command : BOOLEAN );
  667.  
  668. (*----------------------------------------------------------------------*)
  669. (*                                                                      *)
  670. (*     Procedure:  Emit_If_Command                                      *)
  671. (*                                                                      *)
  672. (*     Purpose:    Emit IF conditional command                          *)
  673. (*                                                                      *)
  674. (*     Calling Sequence:                                                *)
  675. (*                                                                      *)
  676. (*        Emit_If_Command(     False_Label       : INTEGER;             *)
  677. (*                         VAR OK_Script_Command : BOOLEAN );           *)
  678. (*                                                                      *)
  679. (*----------------------------------------------------------------------*)
  680.  
  681. VAR
  682.    Qnum   : BOOLEAN;
  683.    IntVal : INTEGER;
  684.    PStr   : AnyStr;
  685.    I      : INTEGER;
  686.    L      : INTEGER;
  687.    Delim  : CHAR;
  688.    Save_IS: INTEGER;
  689.  
  690.    NextP      : INTEGER;
  691.    NextP_Bytes: ARRAY[1..2] OF BYTE ABSOLUTE NextP;
  692.  
  693. BEGIN (* Emit_If_Command *)
  694.                                    (* Back up 1 byte in script buffer   *)
  695.                                    (* We overwrite existing instruction *)
  696.                                    (* with the proper IF guy here.      *)
  697.  
  698.    Script_Buffer_Pos := Script_Buffer_Pos - 1;
  699.  
  700.                                    (* Pick up type of condition *)
  701.  
  702.    Get_String( Script_Line, IS, PStr, Delim );
  703.  
  704.    L    := LENGTH( PStr );
  705.    PStr := UpperCase( PStr );
  706.                                    (* No condition -- bad *)
  707.    IF ( L = 0 ) THEN
  708.       BEGIN
  709.          PStr := 'BAD';
  710.          L    := 3;
  711.       END;
  712.                                    (* Look for NOT *)
  713.  
  714.    IF ( PStr = 'NOT' ) THEN
  715.       BEGIN
  716.  
  717.          I := 0;
  718.  
  719.          Get_String( Script_Line, IS, PStr, Delim );
  720.  
  721.          IS   := IS + 1;
  722.  
  723.          L    := LENGTH( PStr );
  724.          PStr := UpperCase( PStr );
  725.  
  726.       END
  727.    ELSE
  728.       I := 1;
  729.                                    (* True branch -- next statement *)
  730.  
  731.    NextP := Script_Buffer_Pos + 8;
  732.  
  733.                                    (* Analyze condition type *)
  734.    IF ( L >= 3 ) THEN
  735.       IF COPY( PStr, 1, 3 ) = 'CON' THEN
  736.          BEGIN
  737.             Copy_Byte_To_Buffer( ORD( IfConSy ) );
  738.             Copy_Integer_To_Buffer( I );
  739.             Copy_Integer_To_Buffer( NextP );
  740.             Copy_Integer_To_Buffer( False_Label );
  741.          END
  742.       ELSE IF COPY( PStr, 1, 3 ) = 'WAI' THEN
  743.          BEGIN
  744.             Copy_Byte_To_Buffer( ORD( IfFoundSy ) );
  745.             Copy_Integer_To_Buffer( I );
  746.             Copy_Integer_To_Buffer( NextP );
  747.             Copy_Integer_To_Buffer( False_Label );
  748.          END
  749.       ELSE IF COPY( PStr, 1, 3 ) = 'LOC' THEN
  750.          BEGIN
  751.             Save_IS := IS;
  752.             Get_Quoted_String( Script_Line, IS, PStr, Delim );
  753.             L := LENGTH( PStr );
  754.             IF ( NOT ( Delim IN ['''','"'] ) ) THEN
  755.                L := 0;
  756.             Copy_Byte_To_Buffer( ORD( IfLocStrSy ) );
  757.             Copy_Integer_To_Buffer( I );
  758.             Copy_Integer_To_Buffer( NextP + L + 1 );
  759.             Copy_Integer_To_Buffer( False_Label );
  760.             IS := Save_IS;
  761.             Copy_String_To_Buffer;
  762.          END
  763.       ELSE IF COPY( PStr, 1, 3 ) = 'REM' THEN
  764.          BEGIN
  765.             Save_IS := IS;
  766.             Get_Quoted_String( Script_Line, IS, PStr, Delim );
  767.             L := LENGTH( PStr );
  768.             IF ( NOT ( Delim IN ['''','"'] ) ) THEN
  769.                L := 0;
  770.             Copy_Byte_To_Buffer( ORD( IfRemStrSy ) );
  771.             Copy_Integer_To_Buffer( I );
  772.             Copy_Integer_To_Buffer( NextP + L + 1 );
  773.             Copy_Integer_To_Buffer( False_Label );
  774.             IS := Save_IS;
  775.             Copy_String_To_Buffer;
  776.          END
  777.       ELSE
  778.          OK_Script_Command := FALSE
  779.    ELSE
  780.       OK_Script_Command := FALSE;
  781.  
  782. END   (* Emit_If_Command *);
  783.  
  784. (*----------------------------------------------------------------------*)
  785. (*   Parse_Script_Command --- Parse and convert script to internal code *)
  786. (*----------------------------------------------------------------------*)
  787.  
  788. PROCEDURE Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );
  789.  
  790. (*----------------------------------------------------------------------*)
  791. (*                                                                      *)
  792. (*     Procedure:  Parse_Script_Command                                 *)
  793. (*                                                                      *)
  794. (*     Purpose:    Parse and convert script line to internal code.      *)
  795. (*                                                                      *)
  796. (*     Calling Sequence:                                                *)
  797. (*                                                                      *)
  798. (*        Parse_Script_Command( VAR OK_Script_Command : BOOLEAN );      *)
  799. (*                                                                      *)
  800. (*           OK_Script_Command --- set TRUE if legitimate command       *)
  801. (*                                                                      *)
  802. (*----------------------------------------------------------------------*)
  803.  
  804. VAR
  805.    Qnum   : BOOLEAN;
  806.    IntVal : INTEGER;
  807.    ByteVal: BYTE;
  808.    Quote  : CHAR;
  809.    Delim  : CHAR;
  810.    L      : INTEGER;
  811.    I      : INTEGER;
  812.    J      : INTEGER;
  813.    SvPos  : INTEGER;
  814.    PStr   : AnyStr;
  815.  
  816.    NextP      : INTEGER;
  817.    NextP_Bytes: ARRAY[1..2] OF BYTE ABSOLUTE NextP;
  818.  
  819. BEGIN (* Parse_Script_Command *)
  820.                                    (* Assume command is OK to start   *)
  821.    OK_Script_Command := TRUE;
  822.                                    (* Insert command type into buffer *)
  823.  
  824.    Copy_Byte_To_Buffer( ORD( Current_Script_Command ) );
  825.  
  826.                                    (* Pick up and insert command-dependent *)
  827.                                    (* information into script buffer.      *)
  828.    IS := 1;
  829.  
  830.    CASE Current_Script_Command OF
  831.  
  832.       SuspendSy,
  833.       DelaySy    : BEGIN
  834.                       Get_Integer( Script_Line, IS, Qnum, IntVal );
  835.                       IF ( NOT Qnum ) THEN
  836.                          IntVal := 1;
  837.                       Copy_Integer_To_Buffer( IntVal );
  838.                    END;
  839.  
  840.       CaptureSy,
  841.       DialSy,
  842.       DosSy,
  843.       InputSy,
  844.       MessageSy,
  845.       RedialSy,
  846.       STextSy,
  847.       TextSy,
  848.       WaitSy     : Copy_String_To_Buffer;
  849.  
  850.       RInputSy   : BEGIN
  851.                                    (* Copy prompt string to script buffer *)
  852.  
  853.                       Copy_String_To_Buffer;
  854.  
  855.                                    (* Assume echo mode *)
  856.                       I := 1;
  857.                                    (* See if NOECHO appears *)
  858.  
  859.                       Get_String( Script_Line, IS, PStr, Delim );
  860.  
  861.                       PStr := UpperCase( PStr );
  862.  
  863.                       IF ( Pstr = 'NOECHO' ) THEN
  864.                          I := 0;
  865.  
  866.                                    (* Insert echo/noecho flag in buffer *)
  867.  
  868.                       Copy_Integer_To_Buffer( I );
  869.  
  870.                    END;
  871.  
  872.       IfLocStrSy : BEGIN
  873.                                    (* Increment IF level *)
  874.  
  875.                       Script_If_Level := Script_If_Level + 1;
  876.                       Script_If_Stack[Script_If_Level] :=
  877.                          -Script_Buffer_Pos;
  878.  
  879.                                    (* Emit a conditional *)
  880.  
  881.                       Emit_If_Command( 0 , OK_Script_Command );
  882.  
  883.                    END;
  884.  
  885.       ElseSy     : BEGIN
  886.                       IF ( Script_If_Level > 0 ) THEN
  887.                          BEGIN
  888.  
  889.                                    (* Get address of IF statement *)
  890.                                    (* Remember offset is negative *)
  891.  
  892.                             J := -Script_If_Stack[ Script_If_Level ];
  893.  
  894.                                    (* Back up over Else *)
  895.  
  896.                             Script_Buffer_Pos := Script_Buffer_Pos - 1;
  897.  
  898.                                    (* Insert GOTO here to branch  *)
  899.                                    (* around FALSE code.          *)
  900.  
  901.                             Copy_Byte_To_Buffer( ORD( GoToSy ) );
  902.  
  903.                                    (* Address of GoTo not defined   *)
  904.                                    (* since we don't know it yet -- *)
  905.                                    (* leave it zero, and stuff the  *)
  906.                                    (* address of cell to receive    *)
  907.                                    (* fixup address later on IF     *)
  908.                                    (* stack.                        *)
  909.  
  910.                             Script_If_Stack[ Script_If_Level ] :=
  911.                                Script_Buffer_Pos + 1;
  912.  
  913.                             Copy_Integer_To_Buffer( 0 );
  914.  
  915.                                    (* Fixup FALSE branch address in IF *)
  916.  
  917.                             NextP := Script_Buffer_Pos + 1;
  918.  
  919.                             Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  920.                             Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  921.  
  922.                             IF Script_Debug_Mode THEN
  923.                                BEGIN
  924.                                   WRITELN( Script_Debug_File ,
  925.                                            '      Fixup at ', ( J + 5 ):4,
  926.                                            ' to be ',NextP_Bytes[1]:4,
  927.                                           NextP_Bytes[2]:4, ' = ',NextP:8 );
  928.                                END;
  929.  
  930.                          END
  931.                       ELSE
  932.                          OK_Script_Command := FALSE;
  933.  
  934.                    END;
  935.  
  936.       EndIfSy    : BEGIN
  937.  
  938.                       IF ( Script_If_Level > 0 ) THEN
  939.                          BEGIN
  940.  
  941.                             J := Script_If_Stack[ Script_If_Level ];
  942.                             Script_If_Level := Script_If_Level - 1;
  943.  
  944.                                    (* Fixup GoTo before ELSE or   *)
  945.                                    (* FALSE branch in original IF *)
  946.                                    (* if no else.                 *)
  947.  
  948.                             NextP := Script_Buffer_Pos;
  949.  
  950.                             IF ( J > 0 ) THEN
  951.                                BEGIN
  952.                                   Script_Buffer^[ J     ] := NextP_Bytes[1];
  953.                                   Script_Buffer^[ J + 1 ] := NextP_Bytes[2];
  954.                                   IF Script_Debug_Mode THEN
  955.                                      BEGIN
  956.                                         WRITELN( Script_Debug_File ,
  957.                                                  '      Fixup at ', ( J ):4,
  958.                                                  ' to be ',NextP_Bytes[1]:4,
  959.                                                  NextP_Bytes[2]:4, ' = ',NextP:8 );
  960.                                      END;
  961.  
  962.                                END
  963.                             ELSE
  964.                                BEGIN
  965.                                   J := -J;
  966.                                   Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  967.                                   Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  968.                                   IF Script_Debug_Mode THEN
  969.                                      BEGIN
  970.                                         WRITELN( Script_Debug_File ,
  971.                                                  '      Fixup at ', ( J + 5 ):4,
  972.                                                  ' to be ',NextP_Bytes[1]:4,
  973.                                                  NextP_Bytes[2]:4, ' = ',NextP:8 );
  974.                                      END;
  975.  
  976.  
  977.                                END;
  978.  
  979.                                    (* Erase EndIf from buffer *)
  980.  
  981.                             Script_Buffer_Pos := Script_Buffer_Pos - 1;
  982.  
  983.                          END
  984.                       ELSE
  985.                          OK_Script_Command := FALSE;
  986.  
  987.                    END;
  988.  
  989.       KeySendSy  : BEGIN
  990.                       Get_String( Script_Line, IS, PStr, Delim );
  991.                       L := LENGTH( PStr );
  992.                       PStr := UpperCase( PStr );
  993.                       IF ( L > 0 ) THEN
  994.                          BEGIN
  995.                             I := POS( PStr[1] , 'FACS' );
  996.                             IF ( I > 0 ) THEN
  997.                                BEGIN
  998.                                   J := 2;
  999.                                   Get_Integer( PStr, J, Qnum, IntVal );
  1000.                                   IF ( Qnum AND ( IntVal >= 0 ) AND
  1001.                                      ( IntVal <= 10 ) ) THEN
  1002.                                      BEGIN
  1003.                                         CASE I OF
  1004.                                            1: I := 58;
  1005.                                            2: I := 103;
  1006.                                            3: I := 93;
  1007.                                            4: I := 83;
  1008.                                         END (* Case *);
  1009.                                         ByteVal := I + IntVal;
  1010.                                         Copy_Byte_To_Buffer( ByteVal );
  1011.                                      END (* Qnum *);
  1012.                                END (* I > 0 *);
  1013.                          END (* L > 0 *);
  1014.                    END;
  1015.  
  1016.       WaitStrSy  : Emit_Wait_String_Command( OK_Script_Command );
  1017.  
  1018.       WhenSy     : BEGIN
  1019.                       Copy_String_To_Buffer;
  1020.                       IS := IS + 1;
  1021.                       Copy_String_To_Buffer;
  1022.                    END;
  1023.  
  1024.       ReceiveSy  : BEGIN
  1025.                       Copy_String_To_Buffer;
  1026.                       IS := IS + 1;
  1027.                       Copy_Protocol_To_Buffer;
  1028.                    END;
  1029.  
  1030.       SendSy     : BEGIN
  1031.                       Copy_String_To_Buffer;
  1032.                       IS := IS + 1;
  1033.                       Copy_Protocol_To_Buffer;
  1034.                    END;
  1035.  
  1036.       RepeatSy   : BEGIN
  1037.                                    (* Increment repeat level *)
  1038.  
  1039.                       Script_Repeat_Level := Script_Repeat_Level + 1;
  1040.  
  1041.                                    (* Remember where repeat starts. *)
  1042.  
  1043.                       Script_Repeat_Stack[Script_Repeat_Level] :=
  1044.                          Script_Buffer_Pos;
  1045.  
  1046.                                    (* Erase repeat command *)
  1047.  
  1048.                       Script_Buffer_Pos   := Script_Buffer_Pos   - 1;
  1049.  
  1050.                    END;
  1051.  
  1052.       UntilSy    : BEGIN
  1053.                       IF ( Script_Repeat_Level > 0 ) THEN
  1054.                          BEGIN
  1055.  
  1056.                                    (* Pop REPEAT address off stack *)
  1057.  
  1058.                             J := Script_Repeat_Stack[ Script_Repeat_Level ];
  1059.                             Script_Repeat_Level := Script_Repeat_Level - 1;
  1060.  
  1061.                                    (* Emit end of loop test *)
  1062.  
  1063.                             Emit_If_Command( J , OK_Script_Command );
  1064.  
  1065.                          END
  1066.                       ELSE
  1067.                          OK_Script_Command := FALSE;
  1068.                    END;
  1069.  
  1070.       WhileSy    : BEGIN
  1071.                                    (* Increment While level *)
  1072.  
  1073.                       Script_While_Level := Script_While_Level + 1;
  1074.                       Script_While_Stack[Script_While_Level] :=
  1075.                          Script_Buffer_Pos;
  1076.  
  1077.                                    (* Emit conditional command *)
  1078.  
  1079.                       Emit_If_Command( 0 , OK_Script_Command );
  1080.  
  1081.                    END;
  1082.  
  1083.       EndWhileSy : BEGIN
  1084.  
  1085.                       IF ( Script_While_Level > 0 ) THEN
  1086.                          BEGIN
  1087.  
  1088.                             J := Script_While_Stack[ Script_While_Level ];
  1089.                             Script_While_Level := Script_While_Level - 1;
  1090.  
  1091.                             Script_Buffer^[Script_Buffer_Pos] := ORD( GoToSy );
  1092.                             Copy_Integer_To_Buffer( J );
  1093.  
  1094.                             NextP := Script_Buffer_Pos + 1;
  1095.  
  1096.                             Script_Buffer^[ J + 5 ] := NextP_Bytes[1];
  1097.                             Script_Buffer^[ J + 6 ] := NextP_Bytes[2];
  1098.  
  1099.                             IF Script_Debug_Mode THEN
  1100.                                BEGIN
  1101.                                   WRITELN( Script_Debug_File ,
  1102.                                            '      Fixup at ', ( J + 5 ):4,
  1103.                                            ' to be ',NextP_Bytes[1]:4,
  1104.                                            NextP_Bytes[2]:4, ' = ',NextP:8 );
  1105.                                END;
  1106.  
  1107.                          END
  1108.                       ELSE
  1109.                          OK_Script_Command := FALSE;
  1110.  
  1111.                    END;
  1112.  
  1113.       ParamSy    : BEGIN
  1114.  
  1115.                       Get_String( Script_Line, IS, PStr, Delim );
  1116.  
  1117.                       Copy_Byte_To_Buffer( ORD( PStr[1] ) );
  1118.                       Copy_Byte_To_Buffer( ORD( PStr[2] ) );
  1119.  
  1120.                       IF Delim = '=' THEN
  1121.                          IS := IS + 1;
  1122.  
  1123.                       L                 := 0;
  1124.                       Script_Buffer_Pos := Script_Buffer_Pos + 1;
  1125.                       SvPos             := Script_Buffer_Pos;
  1126.  
  1127.                       FOR I := IS TO LENGTH( Script_Line ) DO
  1128.                          BEGIN
  1129.                             L                 := L + 1;
  1130.                             Copy_Byte_To_Buffer( ORD( Script_Line[I] ) );
  1131.                          END;
  1132.  
  1133.                       Script_Buffer^[SvPos] := L;
  1134.  
  1135.                    END;
  1136.  
  1137.       ELSE;
  1138.  
  1139.    END (* CASE *);
  1140.  
  1141. END   (* Parse_Script_Command *);
  1142.  
  1143. (*----------------------------------------------------------------------*)
  1144. (*   Fix_Label_References --- Fix up label references in script buffer  *)
  1145. (*----------------------------------------------------------------------*)
  1146.  
  1147. PROCEDURE Fix_Label_References( VAR OK_Script_Command : BOOLEAN );
  1148.  
  1149. (*----------------------------------------------------------------------*)
  1150. (*                                                                      *)
  1151. (*     Procedure:  Fix_Label_References                                 *)
  1152. (*                                                                      *)
  1153. (*     Purpose:    Fix up label references in script buffer             *)
  1154. (*                                                                      *)
  1155. (*     Calling Sequence:                                                *)
  1156. (*                                                                      *)
  1157. (*        Fix_Label_References( VAR OK_Script_Command : BOOLEAN );      *)
  1158. (*                                                                      *)
  1159. (*           OK_Script_Command --- set TRUE if fixups went OK           *)
  1160. (*                                                                      *)
  1161. (*----------------------------------------------------------------------*)
  1162.  
  1163. BEGIN (* Fix_Label_References *)
  1164.  
  1165.    OK_Script_Command := TRUE;
  1166.  
  1167. END   (* Fix_Label_References *);
  1168.  
  1169. (*----------------------------------------------------------------------*)
  1170.  
  1171. BEGIN (* Process_Script *)
  1172.  
  1173.                                    (* Save current screen *)
  1174.    Save_Screen( Local_Save );
  1175.    Draw_Menu_Frame( 10, 10, 78, 20, Menu_Frame_Color,
  1176.                     Menu_Text_Color, 'Scan script file' );
  1177.  
  1178.                                    (* Pick up script file name *)
  1179.                                    (* if not already supplied  *)
  1180.  
  1181.    IF ( LENGTH( Script_File_Name ) = 0 ) THEN
  1182.       BEGIN
  1183.          WRITE('Script file name ? ');
  1184.          READLN( Script_File_Name );
  1185.       END;
  1186.                                    (* Fix up script file name *)
  1187.  
  1188.    Script_File_Name := UpperCase( Script_File_Name );
  1189.  
  1190.    IF ( POS( '.', Script_File_Name ) = 0 ) THEN
  1191.       Script_File_Name := Script_File_Name + '.SCR';
  1192.  
  1193.                                    (* See if script file exists *)
  1194.  
  1195.    ASSIGN( Byte_File , Script_File_Name );
  1196.       (*$I-*)
  1197.    RESET ( Byte_File );
  1198.       (*$I+*)
  1199.  
  1200.    IF ( Int24Result <> 0 ) THEN
  1201.       BEGIN
  1202.  
  1203.          WRITELN(' ');
  1204.          WRITELN('Script file ',Script_File_Name,' not found.');
  1205.          WRITELN(' ');
  1206.  
  1207.          Really_Wait_String  := FALSE;
  1208.          Script_Suspend_Time := 0.0;
  1209.          Script_File_Mode    := FALSE;
  1210.  
  1211.                                    (* Restore previous screen *)
  1212.          DELAY( Two_Second_Delay );
  1213.  
  1214.          Restore_Screen( Local_Save );
  1215.          Reset_Global_Colors;
  1216.                                    (* Quit now *)
  1217.          EXIT;
  1218.  
  1219.       END
  1220.    ELSE
  1221.       BEGIN
  1222.          WRITELN(' ');
  1223.          WRITELN('Beginning scan of script file ',Script_File_Name);
  1224.          WRITELN(' ');
  1225.       END;
  1226.                                    (* Get size of script file.     *)
  1227.                                    (* Allocate command buffer of   *)
  1228.                                    (* same length to hold compiled *)
  1229.                                    (* script commands.             *)
  1230.  
  1231.    Script_Buffer_Size := FileSize( Byte_File );
  1232.  
  1233.    CLOSE( Byte_File );
  1234.  
  1235.    IF ( Script_File_Name = 'ZZBOGUS.SCR' ) THEN
  1236.       BEGIN
  1237.          ASSIGN ( Script_Debug_File , 'ZZBOGUS.DBG' );
  1238.          REWRITE( Script_Debug_File );
  1239.          Script_Debug_Mode := TRUE;
  1240.       END
  1241.    ELSE
  1242.       Script_Debug_Mode := FALSE;
  1243.  
  1244.    GetMem( Script_Buffer , Script_Buffer_Size );
  1245.  
  1246.                                    (* Current offset in script buffer *)
  1247.    Script_Buffer_Pos  := 0;
  1248.                                    (* No labels yet defined         *)
  1249.    Script_Label_Count := 0;
  1250.                                    (* All stacks empty              *)
  1251.    Script_Repeat_Level := 0;
  1252.    Script_If_Level     := 0;
  1253.    Script_While_Level  := 0;
  1254.                                    (* Open script file as text file *)
  1255.  
  1256.    ASSIGN( Script_File , Script_File_Name );
  1257.       (*$I-*)
  1258.    RESET ( Script_File );
  1259.       (*$I+*)
  1260.                                    (* Read and compile lines from  *)
  1261.                                    (* script file                  *)
  1262.    REPEAT
  1263.                                    (* Read script line             *)
  1264.  
  1265.       READLN( Script_File , Script_Line );
  1266.  
  1267.       Saved_Script_Line := Script_Line;
  1268.       OK_Script_Command := TRUE;
  1269.  
  1270.                                    (* Check for serious read error *)
  1271.       IF Int24Result <> 0 THEN
  1272.          OK_Script_Command := FALSE
  1273.  
  1274.                                    (* Skip comment lines           *)
  1275.  
  1276.       ELSE IF ( LENGTH( Script_Line ) > 0 ) THEN
  1277.          IF ( Script_Line[1] <> '*' ) THEN
  1278.  
  1279.                                    (* Parse and store compiled command *)
  1280.             BEGIN
  1281.  
  1282.                IF Script_Debug_Mode THEN
  1283.                   BEGIN
  1284.                      WRITELN( Script_Debug_File , '--- next statement --- ' );
  1285.                      WRITELN( Script_Debug_File , '<', Script_Line, '>' );
  1286.                      WRITELN( Script_Debug_File , '--- ');
  1287.                   END;
  1288.  
  1289.                Extract_Script_Command( OK_Script_Command );
  1290.  
  1291.                IF OK_Script_Command THEN
  1292.                   Parse_Script_Command  ( OK_Script_Command );
  1293.  
  1294.                IF ( NOT Ok_Script_Command ) THEN
  1295.                   BEGIN
  1296.  
  1297.                      WRITELN('>>> Error in the following script line: ');
  1298.                      WRITELN( Saved_Script_Line );
  1299.  
  1300.                      WRITE('Hit any key to continue ... ');
  1301.  
  1302.                      READ( Kbd, Ch );
  1303.  
  1304.                      IF ( ORD( Ch ) = ESC ) AND KeyPressed THEN
  1305.                         READ( Kbd, Ch );
  1306.  
  1307.                   END;
  1308.  
  1309.          END;
  1310.  
  1311.    UNTIL ( EOF( Script_File ) OR ( NOT OK_Script_Command ) );
  1312.  
  1313.                                    (* Close script file.             *)
  1314.       (*$I-*)
  1315.    CLOSE( Script_File );
  1316.       (*$I+*)
  1317.  
  1318.    I := Int24Result;
  1319.                                    (* Drop "finish script" command   *)
  1320.                                    (* into script buffer.            *)
  1321.  
  1322.    IF Script_Debug_Mode THEN
  1323.       WRITELN( Script_Debug_File , '--- Exit statement follows ... ');
  1324.  
  1325.    Copy_Byte_To_Buffer( ORD( ExitSy ) );
  1326.  
  1327.                                    (* Check if stacks empty.  If not,  *)
  1328.                                    (* error from unclosed loop.        *)
  1329.  
  1330.    OK_Script_Command := OK_Script_Command           AND
  1331.                         ( Script_Repeat_Level = 0 ) AND
  1332.                         ( Script_If_Level     = 0 ) AND
  1333.                         ( Script_While_Level  = 0 );
  1334.  
  1335.                                    (* Fix up label references          *)
  1336.    IF OK_Script_Command THEN
  1337.       Fix_Label_References( OK_Script_Command );
  1338.  
  1339.                                    (* Now point to start of buffer     *)
  1340.    Script_Buffer_Pos := 0;
  1341.                                    (* If everything OK, allow script   *)
  1342.                                    (* to execute, else release buffer. *)
  1343.    Really_Wait_String  := FALSE;
  1344.    Script_Suspend_Time := 0.0;
  1345.  
  1346.    IF OK_Script_Command THEN
  1347.       BEGIN
  1348.          Script_File_Mode   := TRUE;
  1349.          WRITELN('Script file OK.');
  1350.       END
  1351.    ELSE
  1352.       BEGIN
  1353.          WRITELN('Script file will not be executed.');
  1354.          Script_File_Mode   := FALSE;
  1355.          FREEMEM( Script_Buffer , Script_Buffer_Size );
  1356.       END;
  1357.                                    (* Restore previous screen *)
  1358.    DELAY( Two_Second_Delay );
  1359.  
  1360.    Restore_Screen( Local_Save );
  1361.    Reset_Global_Colors;
  1362.  
  1363.    IF Script_Debug_Mode THEN
  1364.       CLOSE( Script_Debug_File );
  1365.  
  1366. END   (* Process_Script *);
  1367.